perm filename CVDMD.F4[DRW,LCS] blob
sn#128696 filedate 1974-12-13 generic text, type T, neo UTF8
00010 COMMON/LL/L /MM/M(600)
00020 DATA JA/1/,JB/1/,JC/1/
00100 N='BDR40'
00200 1 CALL GETFIL(N)
00300 CALL FASTIN(J,11)
00400 CALL FASTIN(M,J)
00500 DO 2 K=1,J
00600 CALL UNPACK(JA,JB,M(K))
00650 JC=L
00700 2 CALL PAC(M(J),JA)
00800 CALL PUTFIL(N)
00900 CALL FASTOU(J,11)
01000 CALL FASTOU(M,J)
01100 N=N+2
01200 GO TO 1
01300 END
02000
02100 SUBROUTINE UNPACK(M,N,I)
02200 COMMON/LL/L
02300 C L IS FOR VIS. OR INVIS. LINES.
02400 N=I
02500 L=2
02600 M=N/100000000
02700 IF(M.EQ.0)GO TO 2
02800 L=3
02900 N=N-100000000*M
03000 2 M=N/10000
03100 N=MOD(N,10000)
03200 IF(M.GT.1000)M=1000-M
03300 IF(N.GT.1000)N=1000-N
03400 END